Mac Mania 2/MacMania 2.toast/Demo's/Tools&Utilities/Programming/MacStarter Pascal 1.0/xWindows definition files/xScaledGraphicsDecoration.p

Text File | 1993-12-11 | 23.2 KB | 756 lines | [TEXT/PJMM]

unit xScaledGraphicsDecoration;

{ This unit defines a sub-class of xWindowDecoration.  A decoration in this subclass provides }
{ methods for doing some basic drawing operations using real coordinates instead of the }
{ usual QuickDraw integer coordinates.   Coordinates in these drawing commands are }
{ automatically scaled to the current decoration size.   Furthermore, when you use these }
{ commands, graphics output is automatically "clipped" so that nothing is drawn outside }
{ the decoration itself.  (The cost of all this convenience will  be some decrease in speed }
{ of drawing operations. ) }
{     A further subclass is defined which includes automatic display of a set of }
{ coordinate axes in the decoration. }

{ NOTE: This UNIT is here for use in the sample project "SimpleGraph".  It works OK, but }
{            really doesn't do the right thing about clipping; that is, it always sets the clip rect}
{            everytime something is drawn into a ScaledGraphicsDecoration, then resets it to }
{            the ENTIRE plane.  This should probably be modified so that it will only do this if }
{            some "autoclip" feature is turned on. }

interface

uses
    xWindow;

type
    xScaledGraphics = object(xWindowDecoration)

            xScale, yScale: extended;   { factors used in scaling calculations }
            xmin, xmax, ymin, ymax: extended;  { range of real-number coordinates for decoration; }
              { Set by default when the decoration is created to 0,1,0,1. }
            useNormalWindow: boolean;  { set to true if user sets coordinates using }
              { SetNormalCoordinates instead of SetCoordinates; false by default }
            xmin_normal, xmax_normal, ymin_normal, ymax_normal: extended;
              { save the parameters used in SetNormalCoordinates }
            fillPattern: Pattern;  { pattern to be used in filling objects; solid black by default }

            procedure Setup (win: xWindow;
                                        theLeft, theTop, theWidth, theHeight: integer);
             { Installs the decoration in the specified xWindow.  The remaining parameters }
             { specify the location and size of the decoration, as described in the comment }
             { for procedure xWindowDecoration.Install in the file xWindow.p }
            procedure SetCoordinates (newXMin, newXMax, newYMin, newYMax: extended);
             { Establishes that (newXMin, newYMin) will be the coordinates of the lower }
             { left corner of the decoration, and (newXMax,NewYMax) the coordinates of the }
             { upper right.  All coordinates used in other procedures will be scaled to this }
             { range.  This procedure will generate an update event to see that the contents }
             { of the decoration are re-drawn in the new coordinate system. }
             {    NOTE:  The default coordinates are set up with SetCoordinates(0,1,0,1) }
             { when the decoration is SetUp. }
            procedure SetNormalCoordinates (newXMin, newXMax, newYMin, newYMax: extended);
             { Like SetCoordinates, this establishes the scaling to be used.  In this case, however, }
             { the scaling will refer to the LARGEST SQUARE that will fit in the decoration. }
             { The square will be centered horizontally or vertically, as appropriate.  Points }
             { in the window outside this square will have coordinates outside the range }
             { newXMin to newXMax or outside newYMin to newYMax. }
             {     This procedure will generate an update event to see that the contents }
             { of the decoration are re-drawn in the new coordinate system. }
            procedure drawLine (x1, y1, x2, y2: extended);
             { Draw a line from (x1,y1) to (x2,y2), IN THE REAL COORDINATE SYSTEM }
             { ESTABLISHED FOR THE DECORATION. }
            procedure drawRectangle (x1, y1, x2, y2: extended);
             { Draw the retangle (sides only) with corners at (x1,y1) and (x2,y2). }
            procedure drawRoundRect (x1, y1, x2, y2: extended);
             { Draw a retangle  with rounded corners at (x1,y1) and (x2,y2). }
            procedure drawOval (x1, y1, x2, y2: extended);
             { Draw the oval that just fits in the rectangle with corners at (x1,y1) and (x2,y2). }
            procedure drawCircle (xCenter, yCenter, radius: extended);
             { Draw a circle with specifed center and radius; if the horizontal scale is different }
             { from the vertical, then the horizontal scale is used to determine the radius drawn }
            procedure drawFilledRectangle (x1, y1, x2, y2: extended);
            procedure drawFilledRoundRect (x1, y1, x2, y2: extended);
            procedure drawFilledOval (x1, y1, x2, y2: extended);
            procedure drawFilledCircle (xCenter, yCenter, radius: extended);
             { These four procedures draw the same figures as their unfilled counterparts, }
             { then fill them with the current fill pattern (solid black by default) }
            procedure clearRectangle (x1, y1, x2, y2: extended);
            procedure clearRoundRect (x1, y1, x2, y2: extended);
            procedure clearOval (x1, y1, x2, y2: extended);
            procedure clearCircle (xCenter, yCenter, radius: extended);
             { These four procedures erase the figures by painting the area occupied by }
             { the figure white; this is different from drawing a filled figure with a white }
             { pattern, since in that case the outline of the figure will still be drawn. }
            procedure SetFillPattern (pat: pattern);
             { Set the current fill pattern to the specified pattern; You can use one of the }
             { Standard patterns: black, gray, ltGray, dkGray, white.  You could also get the }
             { pattern from a pattern resource. }
            procedure SetFillPatternNumber (patternIndex: integer);
             { Set the current fill pattern to one of the 38 standard patterns; the parameter }
             { patternIndex is a number between 1 and 38 specifying the pattern. }
            procedure XY2HV (x, y: extended;
                                        var h, v: integer);
             { Does the scaling of real numbers to standard integer coordinates }
            procedure HV2XY (h, v: integer;
                                        var x, y: extended);
             { Does the reverse scaling of standard window coordinates to real numbers. }
             { This might be useful if you decide to override the doContentClick Procedure.  You  }
             { can use it to convert the localPt parameter of that procedure to the real }
             { number coordinates of the decoration. }
            procedure XYRect2HVRect (x1, y1, x2, y2: extended;
                                        var R: Rect);
            { Converts a rectangle specification in real number coordinates to a standard }
            { integer-coordinate Rect. }
            procedure adjustSize;
            override;
            { called when the size of the window changes; updates instance variables }
            { appropriately  }
        end;

    xScaledGraphicsWithAxes = object(xScaledGraphics)
            { This subclass implements a version of xScaledGraphics that includes an }
            { automatically displayed set of coordinate axes.   The axes are labeled a }
            { according to the range of values currently set by SetCoordinates or }
            { SetNormalCoordinates.  All of the methods for this class have the same }
            { description as those in the parent class, except that they are extended to }
            { compute and/or draw the axes, as appropriate. }
            theAxes: PicHandle;  { the axes }
            procedure Setup (win: xWindow;
                                        theLeft, theTop, theWidth, theHeight: integer);
            override;
            procedure SetCoordinates (newXMin, newXMax, newYMin, newYMax: extended);
            override;
            procedure SetNormalCoordinates (newXMin, newXMax, newYMin, newYMax: extended);
            override;
            procedure doDraw;
            override;
            procedure MakeAxes;
        end;

implementation

procedure xScaledGraphics.Setup (win: xWindow;
                                theLeft, theTop, theWidth, theHeight: integer);
    begin
        init;
        xmin := 0;
        xmax := 1;
        ymin := 0;
        ymax := 1;
        fillPattern := black;
        useNormalWindow := false;
        Install(win, theLeft, theTop, theWidth, theHeight);
    end;

procedure xScaledGraphics.SetCoordinates (newXMin, newXMax, newYMin, newYMax: extended);
    begin
        if (newXMin = newXMax) | (newYmin = newYMax) then
            EXIT(SetCoordinates);
        forceRedraw;
        xmin := newXMin;
        ymin := newYMin;
        xmax := newXMax;
        ymax := newYMax;
        xScale := (clickRect.right - clickRect.left) / (newXMax - newXMin);
        yScale := (clickRect.bottom - clickRect.top) / (newYMax - newYMin);
        useNormalWindow := false;
    end;

procedure xScaledGraphics.SetNormalCoordinates (newXMin, newXMax, newYMin, newYMax: extended);
    var
        h, w: integer;
        excess: extended;
    begin
        if (newXMin = newXMax) | (newYMIN = newYMax) then
            EXIT(SetNormalCoordinates);
        forceRedraw;
        w := clickRect.right - clickRect.left;
        h := clickRect.bottom - clickRect.top;
        xmin_normal := newXMin;
        ymin_normal := newYMin;
        xmax_normal := newXMax;
        ymax_normal := newYMax;
        if w > h then begin
                excess := (w - h) / h * (newXMax - newXMin) / 2;
                newXMin := newXMin - excess;
                newXMax := newXMax + excess;
            end
        else begin
                excess := (h - w) / w * (newYMax - newYMin) / 2;
                newYMax := newYMax + excess;
                newYMin := newYMin - excess;
            end;
        xmin := newXMin;
        ymin := newYMin;
        xmax := newXMax;
        ymax := newYMax;
        xScale := (clickRect.right - clickRect.left) / (newXMax - newXMin);
        yScale := (clickRect.bottom - clickRect.top) / (newYMax - newYMin);
        useNormalWindow := true;
    end;


procedure xScaledGraphics.drawLine (x1, y1, x2, y2: extended);
    var
        savePort: GrafPtr;
        h1, h2, v1, v2: integer;
    begin
        GetPort(savePort);
        SetPort(itsWindow.theWindow);
        ClipRect(clickRect);
        XY2HV(x1, y1, h1, v1);
        XY2HV(x2, y2, h2, v2);
        MoveTo(h1, v1);
        LineTo(h2, v2);
        ClipRect(itsWindow.theWindow^.portRect);
        SetPort(savePort);
    end;

procedure xScaledGraphics.drawRectangle (x1, y1, x2, y2: extended);
    var
        R: Rect;
        savePort: GrafPtr;
    begin
        GetPort(savePort);
        SetPort(itsWindow.theWindow);
        ClipRect(clickRect);
        XYRect2HVRect(x1, y1, x2, y2, R);
        FrameRect(R);
        ClipRect(itsWindow.theWindow^.portRect);
        SetPort(savePort);
    end;

procedure xScaledGraphics.drawRoundRect (x1, y1, x2, y2: extended);
    var
        R: Rect;
        savePort: GrafPtr;
    begin
        GetPort(savePort);
        SetPort(itsWindow.theWindow);
        ClipRect(clickRect);
        XYRect2HVRect(x1, y1, x2, y2, R);
        FrameRoundRect(R, 16, 16);
        ClipRect(itsWindow.theWindow^.portRect);
        SetPort(savePort);
    end;

procedure xScaledGraphics.drawOval (x1, y1, x2, y2: extended);
    var
        R: Rect;
        savePort: GrafPtr;
    begin
        GetPort(savePort);
        SetPort(itsWindow.theWindow);
        ClipRect(clickRect);
        XYRect2HVRect(x1, y1, x2, y2, R);
        FrameOval(R);
        ClipRect(itsWindow.theWindow^.portRect);
        SetPort(savePort);
    end;

procedure xScaledGraphics.drawCircle (xCenter, yCenter, radius: extended);
    var
        R: Rect;
        h, v: integer;
        size: extended;
        savePort: GrafPtr;
    begin
        GetPort(savePort);
        SetPort(itsWindow.theWindow);
        ClipRect(clickRect);
        XY2HV(xCenter, yCenter, h, v);
        size := abs(radius) * xScale;
        if (size < maxint) & (abs(h - size) < maxint) & (abs(h + size) < maxint) & (abs(v - size) < maxint) & (abs(v + size) < maxint) then begin
                SetRect(R, h - round(size), v - round(size), h + round(size), v + round(size));
                FrameOval(R);
            end;
        ClipRect(itsWindow.theWindow^.portRect);
        SetPort(savePort);
    end;

procedure xScaledGraphics.drawFilledRectangle (x1, y1, x2, y2: extended);
    var
        R: Rect;
        savePort: GrafPtr;
    begin
        GetPort(savePort);
        SetPort(itsWindow.theWindow);
        ClipRect(clickRect);
        XYRect2HVRect(x1, y1, x2, y2, R);
        FillRect(R, fillPattern);
        FrameRect(R);
        ClipRect(itsWindow.theWindow^.portRect);
        SetPort(savePort);
    end;

procedure xScaledGraphics.drawFilledRoundRect (x1, y1, x2, y2: extended);
    var
        R: Rect;
        savePort: GrafPtr;
    begin
        GetPort(savePort);
        SetPort(itsWindow.theWindow);
        ClipRect(clickRect);
        XYRect2HVRect(x1, y1, x2, y2, R);
        FillRoundRect(R, 16, 16, fillPattern);
        FrameRoundRect(R, 16, 16);
        ClipRect(itsWindow.theWindow^.portRect);
        SetPort(savePort);
    end;

procedure xScaledGraphics.drawFilledOval (x1, y1, x2, y2: extended);
    var
        R: Rect;
        savePort: GrafPtr;
    begin
        GetPort(savePort);
        SetPort(itsWindow.theWindow);
        ClipRect(clickRect);
        XYRect2HVRect(x1, y1, x2, y2, R);
        FillOval(R, fillPattern);
        FrameOval(R);
        ClipRect(itsWindow.theWindow^.portRect);
        SetPort(savePort);
    end;

procedure xScaledGraphics.drawFilledCircle (xCenter, yCenter, radius: extended);
    var
        R: Rect;
        h, v: integer;
        size: extended;
        savePort: GrafPtr;
    begin
        GetPort(savePort);
        SetPort(itsWindow.theWindow);
        ClipRect(clickRect);
        XY2HV(xCenter, yCenter, h, v);
        size := abs(radius) * xScale;
        if (size < maxint) & (abs(h - size) < maxint) & (abs(h + size) < maxint) & (abs(v - size) < maxint) & (abs(v + size) < maxint) then begin
                SetRect(R, h - round(size), v - round(size), h + round(size), v + round(size));
                FillOval(R, fillPattern);
                FrameOval(R);
            end;
        ClipRect(itsWindow.theWindow^.portRect);
        SetPort(savePort);
    end;

procedure xScaledGraphics.clearRectangle (x1, y1, x2, y2: extended);
    var
        R: Rect;
        savePort: GrafPtr;
    begin
        GetPort(savePort);
        SetPort(itsWindow.theWindow);
        ClipRect(clickRect);
        XYRect2HVRect(x1, y1, x2, y2, R);
        EraseRect(R);
        ClipRect(itsWindow.theWindow^.portRect);
        SetPort(savePort);
    end;

procedure xScaledGraphics.clearRoundRect (x1, y1, x2, y2: extended);
    var
        R: Rect;
        savePort: GrafPtr;
    begin
        GetPort(savePort);
        SetPort(itsWindow.theWindow);
        ClipRect(clickRect);
        XYRect2HVRect(x1, y1, x2, y2, R);
        EraseRoundRect(R, 16, 16);
        ClipRect(itsWindow.theWindow^.portRect);
        SetPort(savePort);
    end;

procedure xScaledGraphics.clearOval (x1, y1, x2, y2: extended);
    var
        R: Rect;
        savePort: GrafPtr;
    begin
        GetPort(savePort);
        SetPort(itsWindow.theWindow);
        ClipRect(clickRect);
        XYRect2HVRect(x1, y1, x2, y2, R);
        EraseOval(R);
        ClipRect(itsWindow.theWindow^.portRect);
        SetPort(savePort);
    end;

procedure xScaledGraphics.clearCircle (xCenter, yCenter, radius: extended);
    var
        R: Rect;
        h, v: integer;
        size: extended;
        savePort: GrafPtr;
    begin
        GetPort(savePort);
        SetPort(itsWindow.theWindow);
        ClipRect(clickRect);
        XY2HV(xCenter, yCenter, h, v);
        size := abs(radius) * xScale;
        if (size < maxint) & (abs(h - size) < maxint) & (abs(h + size) < maxint) & (abs(v - size) < maxint) & (abs(v + size) < maxint) then begin
                SetRect(R, h - round(size), v - round(size), h + round(size), v + round(size));
                EraseOval(R);
            end;
        ClipRect(itsWindow.theWindow^.portRect);
        SetPort(savePort);
    end;

procedure xScaledGraphics.SetFillPatternNumber (patternIndex: integer);
    begin
        if (patternIndex > 0) & (patternIndex <= 38) then
            GetIndPattern(fillPattern, sysPatListID, patternIndex);
    end;

procedure xScaledGraphics.SetFillPattern (pat: pattern);
    begin
        fillPattern := pat;
    end;

procedure xScaledGraphics.XY2HV (x, y: extended;
                                var h, v: integer);
    var
        xInt, yInt: extended;
        size: extended;
    begin
        xInt := clickRect.left + (x - xMin) * xScale;
        yInt := clickRect.bottom - (y - yMin) * yScale;
        if (abs(yInt) < 20000) & (abs(xInt) < 20000) then begin
                h := round(xInt);
                v := round(yInt);
            end
        else begin
                size := 20000 / sqrt(sqr(xInt) + sqr(yInt));
                h := round(xInt * size);
                v := round(yInt * size);
            end;
    end;

procedure xScaledGraphics.HV2XY (h, v: integer;
                                var x, y: extended);
    begin
        x := xmin + (h - clickRect.left) / xScale;
        y := ymin - (v - clickRect.bottom) / yScale;
    end;

procedure xScaledGraphics.XYRect2HVRect (x1, y1, x2, y2: extended;
                                var R: Rect);
    var
        pt1, pt2: point;
    begin
        XY2HV(x1, y1, pt1.h, pt1.v);
        XY2HV(x2, y2, pt2.h, pt2.v);
        Pt2Rect(pt1, pt2, R);
    end;

procedure xScaledGraphics.adjustSize;
    begin
        inherited AdjustSize;
        if useNormalWindow then
            SetNormalCoordinates(xmin_normal, xmax_normal, ymin_normal, ymax_normal)
        else
            SetCoordinates(xmin, xmax, ymin, ymax);
    end;


function FudgeStart (a, b: extended): extended;
{ tries to find a "rounded value" close to a, close to within 5% of b-a }
    var
        diff: extended;
        ans: extended;
        len: integer;
        str: string;
    begin
        diff := abs(0.05 * (b - a));
        if abs(round(a) - a) < diff then
            FudgeStart := round(a)
        else if abs(round(a * 10) / 10 - a) < diff then
            FudgeStart := round(a * 10) / 10
        else begin
                len := 8;
                repeat
                    str := StringOf(a : len);
                    ReadString(str, ans);
                    len := len + 1;
                until (abs(a - ans) < diff) | (len = 30);
                FudgeStart := ans;
            end;
    end;


function Fudge (x: extended): extended;
{ move x to a more "rounded" value; used for labeling axes }
    var
        i, digits: integer;
        y: extended;
    begin
        if (ABS(x) < 0.0005) or (ABS(x) > 500000) then
            fudge := x
        else if (abs(x) < 0.1) | (abs(x) > 5000) then begin
                y := x;
                digits := 0;
                if abs(y) >= 8.875 then
                    while abs(y) >= 8.75 do begin
                            y := y / 10;
                            digits := digits + 1
                        end
                else if abs(y) < 0.875 then
                    while abs(y) < 1 do begin
                            y := y * 10;
                            digits := digits - 1
                        end;
                y := round(y * 4) / 4;
                if digits > 0 then
                    for i := 1 to digits do
                        y := y * 10
                else if digits < 0 then
                    for i := 1 to -digits do
                        y := y / 10;
                fudge := y
            end
        else if abs(x) < 0.5 then
            fudge := round(10 * x) / 10
        else if abs(x) < 2.5 then
            fudge := round(2 * x) / 2
        else if abs(x) < 12 then
            fudge := round(x)
        else if abs(x) < 120 then
            fudge := round(x / 10) * 10
        else if abs(x) < 1200 then
            fudge := round(x / 100) * 100
        else
            fudge := round(x / 1000) * 1000
    end;


{$PUSH}
{$R-}

procedure RealToString (x: extended;   {exported; described above}
                                var s: string);
    var
        n, i: integer;
    begin
        if (abs(x) >= 5e8) or (abs(x) < 5e-8) then begin  { exponential form }
                n := 15;
                repeat  { this is needed since the stupid computer alllows 4 spaces for the exponent even if it is one two or three digits }
                    s := StringOf(x : n);
                    n := n - 1;
                    i := length(s);
                    while (i > 0) & (s[i] = ' ') do
                        i := i - 1;
                    s[0] := chr(i);
                until (length(s) <= 12) | (n = 11)
            end
        else begin
                s := StringOf(x : 1 : 10);
                i := length(s);
                while (i > 0) & (s[i] = '0') do   { strip off trailing zeros }
                    i := i - 1;
                if (i > 0) & (s[i] = '.') then  { strip off terminating decimal point }
                    i := i - 1;
                if i > 12 then  { maximum length allowed for output is 12}
                    s[0] := chr(12)
                else
                    s[0] := chr(i);
            end
    end;

{$POP}

procedure DrawStandardAxes (xmin, xmax, ymin, ymax: extended;
                                left, top: integer;
                                width, height: integer);
{ draw axes with labeled tic marks }
    var
        Labels: array[1..20] of string;
        LabelLocs: array[1..20] of integer;
        LabelRef: integer;
        maxsize: integer;
        labelct, i, w: integer;
        x, y: extended;
        interval: extended;
        LabelsOnLeft: boolean;
        xStart, yStart: extended;
        xAxisLoc, yAxisLoc: integer;
    begin
        if (xmin >= 0) | (xmax < 0) then begin
                yAxisLoc := 0;
                xStart := FudgeStart(xmin, xmax);
            end
        else begin
                yaxisLoc := trunc(-xmin / (xmax - xmin) * width);
                xStart := 0;
            end;
        if (ymin >= 0) | (ymax < 0) then begin
                xAxisLoc := height;
                yStart := FudgeStart(ymin, ymax);
            end
        else begin
                xaxisLoc := height - trunc(-ymin / (ymax - ymin) * height);
                yStart := 0;
            end;
        MoveTo(left, top + xAxisLoc - 1);
        if (xmin > 0) | (xmax <= 0) then begin
                if xmin > 0 then
                    Line(5, 0)
                else
                    Move((5), 0);
                Line((2), 0);
                Move((3), 0);
                Line((2), 0);
                Move((3), 0);
                Line((2), 0);
                Move((3), 0);
            end;
        LineTo(left + width, top + xAxisLoc - 1);
        MoveTo(left + yAxisLoc, top + height);
        if (ymin > 0) | (ymax <= 0) then begin
                if ymin > 0 then
                    Line(0, -(5))
                else
                    Move(0, -(5));
                Line(0, -(2));
                Move(0, -(3));
                Line(0, -(2));
                Move(0, -(3));
                Line(0, -(2));
                Move(0, -(3));
            end;
        LineTo(left + yAxisLoc, top);
        labelct := height div (40);
        if labelct <= 2 then
            labelct := 3;
        interval := fudge((ymax - ymin) / labelct);
        y := yStart + interval;
        labelct := 0;
        maxsize := 0;
        while y < ymax do begin
                labelct := labelct + 1;
                RealToString(y, Labels[labelct]);
                w := StringWidth(Labels[labelct]);
                if w > maxsize then
                    maxsize := w;
                LabelLocs[labelct] := round(height - (y - ymin) / (ymax - ymin) * height);
                y := y + interval
            end;
        y := yStart - interval;
        while y > ymin do begin
                labelct := labelct + 1;
                RealToString(y, Labels[labelct]);
                w := StringWidth(Labels[labelct]);
                if w > maxsize then
                    maxsize := w;
                LabelLocs[labelct] := round(height - (y - ymin) / (ymax - ymin) * height);
                y := y - interval
            end;
        if yAxisLoc > maxsize + (8) then begin
                LabelRef := yAxisLoc - (8);
                LabelsOnLeft := true
            end
        else begin
                LabelRef := yAxisLoc + (8);
                LabelsOnLeft := false
            end;
        for i := 1 to labelct do begin
                MoveTo(left + yaxisloc, top + LabelLocs[i]);
                Line((3), 0);
                Line(-(7), 0);
                MoveTo(left + LabelRef, thePort^.pnLoc.v + (4));
                if LabelsOnLeft then
                    Move(-StringWidth(Labels[i]), 0);
                DrawString(Labels[i])
            end;
        labelct := width div (75);
        if labelct <= 2 then
            labelct := 3;
        interval := fudge((xmax - xmin) / labelct);
        x := xStart + interval;
        labelct := 0;
        while x < xmax do begin
                labelct := labelct + 1;
                RealToString(x, Labels[labelct]);
                LabelLocs[labelct] := round((x - xmin) / (xmax - xmin) * width);
                x := x + interval
            end;
        x := xStart - interval;
        while x > xmin do begin
                labelct := labelct + 1;
                RealToString(x, Labels[labelct]);
                LabelLocs[labelct] := round((x - xmin) / (xmax - xmin) * width);
                x := x - interval
            end;
        if xaxisloc <= (height - (12)) then begin
                LabelRef := xaxisloc + (17);
            end
        else begin
                LabelRef := xaxisloc - (8);
            end;
        for i := 1 to labelct do begin
                MoveTo(left + LabelLocs[i], top + xaxisloc);
                Line(0, (3));
                Line(0, -(7));
                MoveTo(thePort^.pnLoc.h, top + LabelRef);
                Move(-(StringWidth(Labels[i]) div 2), 0);
                DrawString(Labels[i])
            end;
    end;

procedure xScaledGraphicsWithAxes.Setup (win: xWindow;
                                theLeft, theTop, theWidth, theHeight: integer);
    begin
        theAxes := nil;
        inherited SetUp(win, theLeft, theTop, theWidth, theHeight);
    end;

procedure xScaledGraphicsWithAxes.SetCoordinates (newXMin, newXMax, newYMin, newYMax: extended);
    begin
        inherited SetCoordinates(newXMin, newXMax, newYmin, newYmax);
        MakeAxes;
    end;

procedure xScaledGraphicsWithAxes.SetNormalCoordinates (newXMin, newXMax, newYMin, newYMax: extended);
    begin
        inherited SetNormalCoordinates(newXMin, newXMax, newYmin, newYmax);
        MakeAxes;
    end;

procedure xScaledGraphicsWithAxes.MakeAxes;
    var
        savePort: GrafPtr;
        lft, tp, wdth, hght: integer;
        txSize: integer;
    begin
        GetPort(savePort);
        SetPort(itsWindow.theWindow);
        ClipRect(itsWindow.theWindow^.portRect);
        if theAxes <> nil then
            KillPicture(theAxes);
        theAxes := OpenPicture(clickRect);
        lft := clickRect.left;
        tp := clickRect.top;
        wdth := clickRect.right - lft;
        hght := clickRect.bottom - tp;
        txSize := itsWindow.theWindow^.txSize;
        TextSize(10);
        ForeColor(magentaColor);
        DrawStandardAxes(xmin, xmax, ymin, ymax, lft, tp, wdth, hght);
        ForeColor(blackColor);
        TextSize(txSize);
        ClosePicture;
        SetPort(savePort);
    end;

procedure xScaledGraphicsWithAxes.doDraw;
    var
        R: Rect;
        pic: PicHandle;
    begin
        if theAxes <> nil then begin
                R := drawRect;
                pic := theAxes;
                ClipRect(clickRect);
                DrawPicture(pic, R);
                ClipRect(itsWindow.theWindow^.portRect);
            end;
    end;

end.